Se determina el modelo de servicios diarios entre el períodode 2019 hasta julio de 2024 con frecuencia mensual.
ruta_servicios <- "/cloud/project/df_serv_dif.xlsx"
excel_sheets(ruta_servicios)
## [1] "Sheet1"
servicios <- as.data.frame(read_xlsx(ruta_servicios,
sheet = "Sheet1", col_names = T))
## New names:
## " `` -> `...1`
colnames(servicios) <- c("","Indice", "Fecha", "Totales")
servicios <- select(servicios, c("Indice", "Fecha", "Totales"))
servicios$mes <- format(x = servicios$Fecha, format = c("%Y-%m"))
nrow(servicios)
## [1] 183
head(servicios)
## Indice Fecha Totales mes
## 1 1 2019-07-03 -1.0949284 2019-07
## 2 2 2019-07-11 -2.4210608 2019-07
## 3 3 2019-07-20 2.0561828 2019-07
## 4 4 2019-07-22 0.4443343 2019-07
## 5 5 2019-07-31 1.3214042 2019-07
## 6 6 2019-08-05 -3.9744676 2019-08
servicios <- servicios %>%
group_by(Fecha = as.character(mes)) %>%
summarize(Ventas_Totales = sum(Totales),
.groups = "keep")
head(servicios)
## # A tibble: 6 × 2
## # Groups: Fecha [6]
## Fecha Ventas_Totales
## <chr> <dbl>
## 1 2019-07 0.306
## 2 2019-08 -1.44
## 3 2019-09 -0.0466
## 4 2019-10 -2.70
## 5 2019-11 2.50
## 6 2019-12 0.511
nrow(servicios)
## [1] 55
servicios_mes_ts <- ts(servicios$Ventas_Totales,start = 1, frequency = 1)
servicios_mes_xts <- as.xts(servicios_mes_ts, dateFormat = "POSIXct")
ts_plot(servicios_mes_ts, color = "darkgreen", Xtitle = "Fecha",
Ytitle = "Valores",
title = "Serie de servicios mensuales")
plot.xts(x = servicios_mes_xts, bg = "white",
col = "black", labels.col = "black",
main = "Serie de servicios mensuales")
urca::ur.df(servicios_mes_ts)
##
## ###############################################################
## # Augmented Dickey-Fuller Test Unit Root / Cointegration Test #
## ###############################################################
##
## The value of the test statistic is: -4.9202
El valor del estadístico de Dickey-Fuller es -4.9202. Este resultado, significativamente menor que el valor crítico, nos permite rechazar la hipótesis nula de que la serie tiene una raíz unitaria a un nivel de significancia del 5%. En consecuencia, se concluye que la serie de tiempo es estacionaria.
kpss.test(servicios_mes_ts)
## Warning in kpss.test(servicios_mes_ts): p-value greater than printed p-value
##
## KPSS Test for Level Stationarity
##
## data: servicios_mes_ts
## KPSS Level = 0.037601, Truncation lag parameter = 3, p-value = 0.1
KPSS Level = 0.037601, Truncation lag parameter = 3, p-value = 0.1 Ho:La serie de tiempo es estacionaria. Ha:La serie de tiempo no es estacionaria. Dado que el valor p es 0.1, mayor al nivel de significancia convencional de 0.05, no se rechaza la hipótesis nula.
ggAcf(servicios_mes_ts, col = "red", lwd = 1, lag.max = 12)
ggPacf(servicios_mes_ts, col = "blue", lag.max = 12, lwd = 1)
div_mes_serv <- ts_split(servicios_mes_ts,
sample.out =
round(length(servicios_mes_ts)*0.2))
entrena_serv_mes <- div_mes_serv$train
prueba_serv_mes <- div_mes_serv$test
modelo_arima_mes_serv <- auto.arima(entrena_serv_mes,
stepwise = F,
stationary = T)
summary(modelo_arima_mes_serv)
## Series: entrena_serv_mes
## ARIMA(1,0,0) with zero mean
##
## Coefficients:
## ar1
## -0.2623
## s.e. 0.1435
##
## sigma^2 = 16.4: log likelihood = -123.51
## AIC=251.01 AICc=251.31 BIC=254.58
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 0.07377221 4.003758 2.770434 103.9453 113.5065 0.5176432
## ACF1
## Training set 0.03846146
# AIC=251.01 AICc=251.31 BIC=254.58
# ARIMA(1,0,0) with zero mean
checkresiduals(modelo_arima_mes_serv, col = "red") # p-value = 0.4597
##
## Ljung-Box test
##
## data: Residuals from ARIMA(1,0,0) with zero mean
## Q* = 7.7354, df = 8, p-value = 0.4597
##
## Model df: 1. Total lags used: 9
pronostico_mes_serv <- forecast(modelo_arima_mes_serv,
h = length(prueba_serv_mes),
level = 0.95)
prueba_serv_mes <- as.numeric(prueba_serv_mes)
prueba_serv_mes[prueba_serv_mes == 0] <- 1e-6
accuracy(pronostico_mes_serv$mean, prueba_serv_mes)
## ME RMSE MAE MPE MAPE
## Test set -0.1882187 2.071384 1.682836 33836.29 57808.15
# ME RMSE MAE MPE MAPE
# Test set -0.1882189 2.071384 1.682836 33836.29 57808.15
accuracy(pronostico_mes_serv$mean[1:6], prueba_serv_mes[1:6])
## ME RMSE MAE MPE MAPE
## Test set -0.509276 1.810381 1.163069 61949.87 105898.3
# ME RMSE MAE MPE MAPE
# Test set -0.5092763 1.810381 1.163069 61949.87 105898.3
El modelo determinado tiene valores de exactitud muy altos o lejanos del valor ideal (cero), el mejor modelo para servicios mensuales es el RML el cual tiene mejores valores de exactitud.